home *** CD-ROM | disk | FTP | other *** search
/ Workbench Design / WB Collection.iso / workbench werkzeuge / palette tools / wcc / wcc4.mod < prev    next >
Text File  |  1996-04-07  |  23KB  |  925 lines
  1. MODULE WCC4;
  2.  
  3. (*
  4.  
  5.    WCC 4.0    (29.4.1993)
  6.  
  7.    by Carsten Orthbandt
  8.  
  9.    Compiler: Amiga Oberon 3.1
  10.  
  11. *)
  12.  
  13. IMPORT
  14.   e: Exec,
  15.   es: ExecSupport,
  16.   cx: Commodities,
  17.   u: Utility,
  18.   I: Intuition,
  19.   gt: GadTools,
  20.   rq:ReqTools,
  21.   frq:FileReq,
  22.   d:Dos,
  23.   arg:Arguments,
  24.   g:Graphics,
  25.   wb:Workbench,
  26.   ol:OberonLib,
  27.   ic:Icon,
  28.   conv:Conversions,
  29.   fs:FileSystem,
  30.   str:Strings,
  31.   y: SYSTEM;
  32.  
  33. CONST
  34.   pVers=40;
  35.  
  36. CONST  verstring="$VER: WCC 4.01 by HDS 1994";
  37.        namstring="Workbench Colour Changer";
  38.  
  39. TYPE  colarp=ARRAY 256,3 OF LONGINT;
  40.  
  41. VAR
  42.      PopKey:ARRAY 100 OF CHAR;
  43.      MyBrk :cx.CxObjPtr;
  44.      MyFil :cx.CxObjPtr;
  45.      MySnd :cx.CxObjPtr;
  46.      MyTrs :cx.CxObjPtr;
  47.      NwBrk :cx.NewBroker;
  48.      MsPrt :e.MsgPortPtr;
  49.      Quit,guiOn  :BOOLEAN;
  50.      ChCol :BOOLEAN;
  51.      Err,cfc :LONGINT;
  52.      eMsg  :e.APTR;
  53.      Msg   :cx.CxMsgPtr;
  54.      MsTp  :LONGSET;
  55.      MsId  :LONGINT;
  56.      CxPri :LONGINT;
  57.      CxKey :ARRAY 254 OF CHAR;
  58.      CxPop :BOOLEAN;
  59.      Signal:LONGSET;
  60.      iVer:LONGINT;
  61.  
  62. VAR n:INTEGER;
  63.     ms:I.IntuiMessagePtr;
  64.     ok:BOOLEAN;
  65.     iad:I.GadgetPtr;
  66.     colcn,colar:colarp;
  67.     pfnam,iffnam,wbnam:ARRAY 256 OF CHAR;
  68.     cnt:LONGINT;
  69.     fl:fs.File;
  70.     exMsg:e.MessagePtr;
  71.     Dela,Cycl:LONGINT;
  72.     Prefsname:ARRAY 30 OF CHAR;
  73.     DoCh:BOOLEAN;
  74.  
  75. PROCEDURE GetToolTypes;
  76. VAR This:d.ProcessPtr;
  77.     wbm:wb.WBStartupPtr;
  78.     sptr:e.STRPTR;
  79.     MyIcon:wb.DiskObjectPtr;
  80.     OCurrentDir:d.FileLockPtr;
  81.     nm:INTEGER;
  82.     ttstrg:ARRAY 256 OF CHAR;
  83. BEGIN;
  84. CxPri:=0;
  85. CxKey:=verstring;
  86. CxKey:="alt control w";
  87. CxPop:=TRUE;
  88. Dela:=1;Cycl:=10;
  89. This:=y.VAL(d.ProcessPtr,ol.Me);
  90. IF ol.wbStarted THEN
  91.  wbm:=ol.wbenchMsg;
  92.  OCurrentDir:=This.currentDir;
  93.  y.SETREG(0,d.CurrentDir(wbm.argList[0].lock));
  94.  MyIcon := ic.GetDiskObject(wbm.argList[0].name^);
  95.  y.SETREG(0,d.CurrentDir(OCurrentDir));
  96.  IF MyIcon#NIL THEN
  97.   sptr := ic.FindToolType(MyIcon.toolTypes,"DELAY");
  98.   IF sptr#NIL THEN IF conv.StringToInt(sptr^,Dela) THEN END;END;
  99.   sptr := ic.FindToolType(MyIcon.toolTypes,"CYCLE");
  100.   IF sptr#NIL THEN IF conv.StringToInt(sptr^,Cycl) THEN END;END;
  101.   sptr := ic.FindToolType(MyIcon.toolTypes,"CX_PRIORITY");
  102.   IF sptr#NIL THEN IF conv.StringToInt(sptr^,CxPri) THEN END;END;
  103.   sptr := ic.FindToolType(MyIcon.toolTypes,"CX_POPKEY");
  104.   IF sptr#NIL THEN COPY(sptr^,CxKey);END;
  105.   sptr := ic.FindToolType(MyIcon.toolTypes,"CX_POPUP");
  106.   IF sptr#NIL THEN COPY(sptr^,ttstrg);END;
  107.   str.Upper(ttstrg);
  108.   IF (ttstrg="FALSE")OR(ttstrg="NO") THEN CxPop:=FALSE;END;
  109.   ic.FreeDiskObject(MyIcon);
  110.  END;
  111. ELSE
  112.  IF arg.NumArgs()>0 THEN
  113.   FOR nm:=1 TO arg.NumArgs() DO
  114.   arg.GetArg(nm,ttstrg);
  115.   IF ttstrg="QUIET"
  116.   THEN CxPop:=FALSE;
  117.   ELSE
  118.    IF ttstrg="CX_POPUP=NO"
  119.    THEN CxPop:=FALSE;
  120.    ELSE
  121.     COPY(ttstrg,pfnam);
  122.    END;
  123.   END;
  124.  END;
  125.  END;
  126. END;
  127. Cycl:=Cycl;
  128. END GetToolTypes;
  129.  
  130. (* GUI Stuff *)
  131.  
  132. CONST
  133.   GDSave                            * = 0;
  134.   GDUse                             * = 1;
  135.   GDCancel                          * = 2;
  136.   GDEdit                            * = 3;
  137.   GDLoad                            * = 4;
  138.  
  139.   mnOpen   *=-2048;
  140.   mnSave   *=-2016;
  141.   mnAbout  *=-1984;
  142.   mnHide   *=-1952;
  143.   mnQuit   *=-1920;
  144.   mnInIFF  *=-2047;
  145.   mnInWB   *=-2015;
  146.   mnOutIFF *=-2046;
  147.   mnOutWB  *=-2014;
  148.   mnStart  *=-2045;
  149.   mnCycle  *=-2013;
  150.  
  151.  
  152.  
  153.  
  154. CONST
  155.   prjCNT = 5;
  156.   prjLeft = 25;
  157.   prjTop = 42;
  158.   prjWidth = 311;
  159.   prjHeight = 62;
  160.  
  161. VAR
  162.   Scr*: I.ScreenPtr;
  163.   ScrCols: INTEGER;
  164.   VisualInfo*: e.APTR;
  165.   prjWnd*: I.WindowPtr;
  166.   prjGList*: I.GadgetPtr;
  167.   prjGadgets*: ARRAY prjCNT OF I.GadgetPtr;
  168.   Project0Menus*: I.MenuPtr;
  169.   Font*: g.TextAttrPtr;
  170.   Attr*: g.TextAttr;
  171.   FontX, FontY: INTEGER;
  172.   OffX, OffY: INTEGER;
  173.   ctPrt:e.MsgPortPtr;
  174.  
  175. TYPE
  176.   Project0MArray = ARRAY    16 OF gt.NewMenu;
  177. CONST
  178.   Project0NewMenu = Project0MArray (
  179.     gt.title, y.ADR ("Project"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  180.     gt.item, y.ADR ("Open..."), y.ADR ("O"), {}, y.VAL (LONGSET, 0), NIL,
  181.     gt.item, y.ADR ("Save..."), y.ADR ("S"), {}, y.VAL (LONGSET, 0), NIL,
  182.     gt.item, y.ADR ("About..."), y.ADR ("A"), {}, y.VAL (LONGSET, 0), NIL,
  183.     gt.item, y.ADR ("Hide"), y.ADR ("H"), {}, y.VAL (LONGSET, 0), NIL,
  184.     gt.item, y.ADR ("Quit"), y.ADR ("Q"), {}, y.VAL (LONGSET, 0), NIL,
  185.     gt.title, y.ADR ("Import"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  186.     gt.item, y.ADR ("IFF Pic..."), NIL, {}, y.VAL (LONGSET, 0), NIL,
  187.     gt.item, y.ADR ("WB Prefs..."), NIL, {}, y.VAL (LONGSET, 0), NIL,
  188.     gt.title, y.ADR ("Export"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  189.     gt.item, y.ADR ("IFF Palette..."), NIL, {}, y.VAL (LONGSET, 0), NIL,
  190.     gt.item, y.ADR ("WB Prefs..."), NIL, {}, y.VAL (LONGSET, 0), NIL,
  191.     gt.title, y.ADR ("Settings"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  192.     gt.item, y.ADR ("Start delay..."), y.ADR ("S"), {}, y.VAL (LONGSET, 0), NIL,
  193.     gt.item, y.ADR ("Cycle delay..."), y.ADR ("C"), {}, y.VAL (LONGSET, 0), NIL,
  194.     gt.end, NIL, NIL, {}, LONGSET {}, NIL);
  195. VAR
  196.   prjIText: ARRAY 1 OF I.IntuiText;
  197. TYPE
  198.   prjGTypesArray = ARRAY prjCNT OF INTEGER;
  199. CONST
  200.   prjGTypes = prjGTypesArray (
  201.     gt.buttonKind,
  202.     gt.buttonKind,
  203.     gt.buttonKind,
  204.     gt.buttonKind,
  205.     gt.buttonKind
  206.   );
  207.  
  208. TYPE
  209.   prjNGadArray = ARRAY prjCNT OF gt.NewGadget;
  210. CONST
  211.   prjNGad = prjNGadArray (
  212.     8, 37, 71, 17, y.ADR ("Save"), NIL, GDSave, LONGSET {gt.placeTextIn} ,NIL, NIL,
  213.     158, 37, 71, 17, y.ADR ("Use"), NIL, GDUse, LONGSET {gt.placeTextIn} ,NIL, NIL,
  214.     233, 37, 71, 17, y.ADR ("Cancel"), NIL, GDCancel, LONGSET {gt.placeTextIn} ,NIL, NIL,
  215.     233, 12, 71, 17, y.ADR ("Edit"), NIL, GDEdit, LONGSET {gt.placeTextIn} ,NIL, NIL,
  216.     83, 37, 71, 17, y.ADR ("Load"), NIL, GDLoad, LONGSET {gt.placeTextIn} ,NIL, NIL
  217.   );
  218.  
  219. TYPE
  220.   prjGTagsArray = ARRAY     5 OF u.Tag;
  221. CONST
  222.   prjGTags = prjGTagsArray (
  223.     u.done,
  224.     u.done,
  225.     u.done,
  226.     u.done,
  227.     u.done
  228.   );
  229.  
  230. PROCEDURE ComputeX (value: INTEGER): INTEGER;
  231. BEGIN
  232.   RETURN ((FontX * value) + 4 ) DIV 8;
  233. END ComputeX;
  234.  
  235. PROCEDURE ComputeY (value: INTEGER): INTEGER;
  236. BEGIN
  237.   RETURN ((FontY * value)  + 4 ) DIV 8;
  238. END ComputeY;
  239.  
  240. PROCEDURE ComputeFont (width, height: INTEGER);
  241. BEGIN
  242.   Font := y. ADR (Attr);
  243.   Font^.name := Scr^.rastPort.font^.message.node.name;
  244.   FontY := Scr^.rastPort.font^.ySize;
  245.   Font^.ySize := FontY;
  246. (*  FontX := Scr^.rastPort.font^.xSize;
  247. *)
  248.   FontX:=g.TextLength(y.ADR(Scr^.rastPort),"ABCDEFHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz 0123456789.",64) DIV 64;
  249.   OffX := Scr^.wBorLeft;
  250.   OffY := Scr^.rastPort.txHeight + Scr^.wBorTop + 1;
  251.  
  252.   IF (width # 0) AND (height # 0) AND
  253.      (ComputeX (width) + OffX + Scr^.wBorRight > Scr^.width) OR
  254.      (ComputeY (height) + OffY + Scr^.wBorBottom > Scr^.height) THEN
  255.     Font^.name := y.ADR ("topaz.font");
  256.     Font^.ySize := 8;
  257.     FontY := Font^.ySize;
  258.     FontX := Font^.ySize;
  259.   END;
  260. END ComputeFont;
  261.  
  262. PROCEDURE SetupScreen* (): INTEGER;
  263. BEGIN
  264.   Scr := I.LockPubScreen (NIL);  IF Scr = NIL THEN RETURN 1 END;
  265.  
  266.   ComputeFont (0, 0);
  267.  
  268.   VisualInfo := gt.GetVisualInfo (Scr, u.done);
  269.   IF VisualInfo = NIL THEN RETURN 2 END;
  270.  
  271.   RETURN 0;
  272. END SetupScreen;
  273.  
  274. PROCEDURE CloseDownScreen*;
  275. BEGIN
  276.   IF VisualInfo # NIL THEN
  277.     gt.FreeVisualInfo (VisualInfo);
  278.     VisualInfo := NIL;
  279.   END;
  280.   IF Scr # NIL THEN
  281.     I.UnlockPubScreen (NIL, Scr);
  282.     Scr := NIL;
  283.   END;
  284. END CloseDownScreen;
  285.  
  286. PROCEDURE prjRender*;
  287. BEGIN
  288.   prjIText[0].iText     := y.ADR (namstring);
  289.   prjIText[0].iTextFont := Font;
  290.   prjIText[0].frontPen  := 1;
  291.   prjIText[0].backPen   := 0;
  292.   prjIText[0].drawMode  := g.jam1+SHORTSET {};
  293.   prjIText[0].leftEdge  := OffX + ComputeX (116) - (I.IntuiTextLength (prjIText[0]) DIV 2);
  294.   prjIText[0].topEdge   := OffY + ComputeY (20) - (Font^.ySize DIV 2);
  295.   prjIText[0].nextText  := NIL;
  296.  
  297.   I.PrintIText (prjWnd^.rPort, prjIText[0], 0, 0);
  298.   gt.DrawBevelBox(prjWnd^.rPort, OffX + ComputeX (8),
  299.                   OffY + ComputeY (12),
  300.                   ComputeX (221),
  301.                   ComputeY (17),
  302.                   gt.visualInfo, VisualInfo, gt.bbRecessed, I.LTRUE, u.done);
  303. END prjRender;
  304.  
  305. PROCEDURE OpenprjWindow* (): INTEGER;
  306. TYPE
  307.   TagArrayPtr = UNTRACED POINTER TO ARRAY MAX (INTEGER) OF u.TagItem;
  308. VAR
  309.   ng: gt.NewGadget;
  310.   gad: I.GadgetPtr;
  311.   help: TagArrayPtr;
  312.   lc, tc, lvc, offx, offy: INTEGER;
  313.   wleft, wtop, ww, wh: INTEGER;
  314. BEGIN
  315.   wleft := prjLeft; wtop := prjTop;
  316.  
  317.   ComputeFont (prjWidth, prjHeight);
  318.  
  319.   ww := ComputeX (prjWidth);
  320.   wh := ComputeY (prjHeight);
  321.  
  322.   IF wleft + ww + OffX + Scr^.wBorRight > Scr^.width THEN
  323.     wleft := Scr^.width - ww;
  324.   END;
  325.   IF wtop + wh + OffY + Scr^.wBorBottom > Scr^.height THEN
  326.     wtop := Scr^.height - wh;
  327.   END;
  328.   Project0Menus := gt.CreateMenus (Project0NewMenu,gt.fullMenu,I.LTRUE, u.done);
  329.   IF Project0Menus = NIL THEN RETURN 3 END;
  330.  
  331.   IF NOT gt.LayoutMenus (Project0Menus, VisualInfo,gt.mnNewLookMenus,I.LTRUE, u.done) THEN RETURN 4 END;
  332.  
  333.   gad := gt.CreateContext (prjGList);
  334.   IF gad = NIL THEN RETURN 1 END;
  335.  
  336.   lc := 0; tc := 0; lvc := 0;
  337.   WHILE lc < prjCNT DO
  338.     ng := prjNGad[lc];
  339.     ng.visualInfo := VisualInfo;
  340.     ng.textAttr   := Font;
  341.     ng.leftEdge   := OffX + ComputeX (ng.leftEdge);
  342.     ng.topEdge    := OffY + ComputeY (ng.topEdge);
  343.     ng.width      := ComputeX (ng.width);
  344.     ng.height     := ComputeY (ng.height);
  345.     gad := gt.CreateGadget (prjGTypes[lc], gad, ng, u.done );
  346.     IF gad = NIL THEN RETURN 2 END;
  347.     prjGadgets[lc] := gad;
  348.  
  349.     WHILE prjGTags[tc] # u.done DO INC (tc, 2) END;
  350.     INC (tc);
  351.  
  352.     INC (lc);
  353.   END; (* WHILE *)
  354.   prjWnd := I.OpenWindowTagsA ( NIL,
  355.                     I.waLeft,          wleft,
  356.                     I.waTop,           wtop,
  357.                     I.waWidth,         ww + OffX + Scr^.wBorRight,
  358.                     I.waHeight,        wh + OffY + Scr^.wBorBottom,
  359.                     I.waIDCMP,         gt.buttonIDCMP+LONGSET {I.menuPick,I.closeWindow,I.refreshWindow},
  360.                     I.waFlags,         LONGSET {I.windowDrag,I.windowDepth,I.activate},
  361.                     I.waGadgets,       prjGList,
  362.                     I.waTitle,         y.ADR ("WCC by HDS 1994"),
  363.                     I.waScreenTitle,   y.ADR ("Workbench Screen"),
  364.                     I.waPubScreen,     Scr,
  365.                     I.waAutoAdjust,    I.LTRUE,
  366.                     I.waNewLookMenus,   I.LTRUE,
  367.                     u.done);
  368.   IF prjWnd = NIL THEN RETURN 20 END;
  369.   IF NOT I.SetMenuStrip (prjWnd, Project0Menus^) THEN RETURN 5 END;
  370.  
  371.   gt.RefreshWindow (prjWnd, NIL);
  372.  
  373.   prjRender;
  374.  
  375.   RETURN 0;
  376. END OpenprjWindow;
  377.  
  378. PROCEDURE CloseprjWindow*;
  379. BEGIN
  380.   IF prjWnd # NIL THEN
  381.     I.CloseWindow (prjWnd);
  382.     prjWnd := NIL;
  383.   END;
  384.   IF prjGList # NIL THEN
  385.     gt.FreeGadgets (prjGList);
  386.     prjGList := NIL;
  387.   END;
  388. END CloseprjWindow;
  389.  
  390. (* Colour Set/Load/Save *)
  391. (*
  392. PROCEDURE ReadCols;
  393. VAR m,k,l:INTEGER;scr:I.ScreenPtr;
  394. BEGIN;
  395. scr:=I.LockPubScreen("Workbench");
  396. m:=scr.bitMap.depth;
  397. k:=1;FOR l:=1 TO m DO k:=k*2;END;
  398. FOR m:=0 TO k-1 DO
  399.  colar[m]:=g.GetRGB4(scr.viewPort.colorMap,m);END;
  400. I.UnlockPubScreen(NIL,scr);
  401. END ReadCols;
  402.  
  403. PROCEDURE SetCols;
  404. VAR m,k,l:INTEGER;scr:I.ScreenPtr;
  405. BEGIN;
  406.  scr:=I.LockPubScreen("Workbench");
  407. m:=scr.bitMap.depth;
  408. k:=1;FOR l:=1 TO m DO k:=k*2;END;
  409. g.LoadRGB4(y.ADR(scr.viewPort),colar^,k);
  410. I.UnlockPubScreen(NIL,scr);
  411. END SetCols;
  412. *)
  413.  
  414. PROCEDURE ReadCols4;
  415. VAR m,k,l:INTEGER;scr:I.ScreenPtr;li,lb:LONGINT;
  416. BEGIN;
  417. scr:=I.LockPubScreen("Workbench");
  418. FOR m:=0 TO ScrCols-1 DO
  419.  li:=g.GetRGB4(scr.viewPort.colorMap,m);
  420.  lb:=li MOD 32;li:=li DIV 32;
  421.  colar[m,0]:=SHORT(lb);
  422.  lb:=li MOD 32;li:=li DIV 32;
  423.  colar[m,1]:=SHORT(lb);
  424.  lb:=li MOD 32;li:=li DIV 32;
  425.  colar[m,2]:=SHORT(lb);
  426. END;
  427. I.UnlockPubScreen(NIL,scr);
  428. END ReadCols4;
  429.  
  430. PROCEDURE ReadCols32;
  431. VAR m,k,l:INTEGER;scr:I.ScreenPtr;li,lb:LONGINT;
  432.     ar:ARRAY 3 OF LONGINT;
  433. BEGIN;
  434. scr:=I.LockPubScreen("Workbench");
  435. FOR m:=0 TO ScrCols-1 DO
  436.  g.GetRGB32(scr.viewPort.colorMap,m,1,ar);
  437.  colar[m,0]:=ar[0];
  438.  colar[m,1]:=ar[1];
  439.  colar[m,2]:=ar[2];
  440. END;
  441. I.UnlockPubScreen(NIL,scr);
  442. END ReadCols32;
  443.  
  444. PROCEDURE SetCols4;
  445. VAR m,k,l:INTEGER;scr:I.ScreenPtr;
  446. BEGIN;
  447.  scr:=I.LockPubScreen("Workbench");
  448. FOR l:=0 TO ScrCols-1 DO
  449. g.SetRGB4(y.ADR(scr.viewPort),l,SHORT(colar[l,0]),SHORT(colar[l,1]),SHORT(colar[l,2]));
  450. END;
  451. I.UnlockPubScreen(NIL,scr);
  452. END SetCols4;
  453.  
  454. PROCEDURE SetCols32;
  455. VAR m,k,l:INTEGER;scr:I.ScreenPtr;c1,c2,c3:LONGINT;
  456. BEGIN;
  457.  scr:=I.LockPubScreen("Workbench");
  458. FOR l:=0 TO ScrCols-1 DO
  459. c1:=colar[l,0];
  460. c2:=colar[l,1];
  461. c3:=colar[l,2];
  462. g.SetRGB32(y.ADR(scr.viewPort),l,c1,c2,c3);
  463. END;
  464. I.UnlockPubScreen(NIL,scr);
  465. END SetCols32;
  466.  
  467. PROCEDURE SetCols;
  468. BEGIN;
  469. IF iVer<39 THEN
  470.  SetCols4;
  471. ELSE
  472.  SetCols32;
  473. END;
  474. END SetCols;
  475.  
  476. PROCEDURE ReadCols;
  477. BEGIN;
  478. IF iVer<39 THEN
  479.  ReadCols4;
  480. ELSE
  481.  ReadCols32;
  482. END;
  483. END ReadCols;
  484.  
  485. PROCEDURE ReadColsCn;
  486. BEGIN;
  487. ReadCols;
  488. colcn:=colar;
  489. END ReadColsCn;
  490.  
  491. PROCEDURE SetColsCn;
  492. BEGIN;
  493. colar:=colcn;
  494. SetCols;
  495. END SetColsCn;
  496.  
  497. (*
  498. PROCEDURE ReadColsCn;
  499. VAR m,k,l:INTEGER;scr:I.ScreenPtr;
  500. BEGIN;
  501. scr:=I.LockPubScreen("Workbench");
  502. m:=scr.bitMap.depth;
  503. k:=1;FOR l:=1 TO m DO k:=k*2;END;
  504. FOR m:=0 TO k-1 DO
  505.  colcn[m]:=g.GetRGB4(scr.viewPort.colorMap,m);END;
  506. I.UnlockPubScreen(NIL,scr);
  507. END ReadColsCn;
  508.  
  509. PROCEDURE SetColsCn;
  510. VAR m,k,l:INTEGER;scr:I.ScreenPtr;
  511. BEGIN;
  512.  scr:=I.LockPubScreen("Workbench");
  513. m:=scr.bitMap.depth;
  514. k:=1;FOR l:=1 TO m DO k:=k*2;END;
  515. g.LoadRGB4(y.ADR(scr.viewPort),colcn^ ,k);
  516. I.UnlockPubScreen(NIL,scr);
  517. END SetColsCn;
  518. *)
  519.  
  520. PROCEDURE LoadCols;
  521. VAR m:INTEGER;
  522.     c1:CHAR;li:LONGINT;
  523. BEGIN;
  524. ok:=TRUE;
  525. ok:=fs.Open(fl,"ENVARC:wcc.prefs",FALSE);
  526. IF ok THEN
  527.  ok:=ok AND fs.ReadBlock(fl,y.ADR(li),y.SIZE(li));
  528.   IF li#pVers THEN ok:=FALSE;END;
  529.  ok:=ok AND fs.ReadBlock(fl,y.ADR(li),y.SIZE(li));
  530.   IF li#iVer THEN ok:=FALSE;END;
  531.  ok:=ok AND fs.ReadBlock(fl,y.ADR(colar),y.SIZE(colar));
  532.  IF fs.Close(fl) THEN END;
  533.  IF ok THEN SetCols;END;
  534. END;
  535. IF ~ok THEN ReadCols;END;
  536. END LoadCols;
  537.  
  538. PROCEDURE LoadColsFr;
  539. VAR m:INTEGER;
  540.     c1:CHAR;li:LONGINT;
  541. BEGIN;
  542. ok:=TRUE;
  543. ok:=fs.Open(fl,pfnam,FALSE);
  544. IF ok THEN
  545.  ok:=ok AND fs.ReadBlock(fl,y.ADR(li),y.SIZE(li));
  546.   IF li#pVers THEN ok:=FALSE;END;
  547.  ok:=ok AND fs.ReadBlock(fl,y.ADR(li),y.SIZE(li));
  548.   IF li#iVer THEN ok:=FALSE;END;
  549.  ok:=ok AND fs.ReadBlock(fl,y.ADR(colar),y.SIZE(colar));
  550.  IF fs.Close(fl) THEN END;
  551. END;
  552. IF ~ok THEN ReadCols;END;
  553. END LoadColsFr;
  554.  
  555. PROCEDURE LoadColsAs;
  556. VAR m:INTEGER;
  557.     ok:BOOLEAN;li:LONGINT;
  558. BEGIN;
  559. IF frq.FileReqWin("Load WCC prefs file",pfnam,prjWnd) THEN
  560. ok:=TRUE;
  561. ok:=fs.Open(fl,pfnam,FALSE);
  562. IF ok THEN
  563.  ok:=ok AND fs.ReadBlock(fl,y.ADR(li),y.SIZE(li));
  564.   IF li#pVers THEN ok:=FALSE;END;
  565.  ok:=ok AND fs.ReadBlock(fl,y.ADR(li),y.SIZE(li));
  566.   IF li#iVer THEN ok:=FALSE;END;
  567.  ok:=ok AND fs.ReadBlock(fl,y.ADR(colar),y.SIZE(colar));
  568.  IF fs.Close(fl) THEN END;
  569.  IF ok THEN SetCols;END;
  570. END;
  571. IF ~ok THEN ReadCols;END;
  572. END;
  573. END LoadColsAs;
  574.  
  575. PROCEDURE LoadColsOn;
  576. VAR m:INTEGER;
  577.     ok:BOOLEAN;li:LONGINT;
  578. BEGIN;
  579. ok:=TRUE;
  580. ok:=fs.Open(fl,pfnam,FALSE);
  581. IF ok THEN
  582.  ok:=ok AND fs.ReadBlock(fl,y.ADR(li),y.SIZE(li));
  583.   IF li#pVers THEN ok:=FALSE;END;
  584.  ok:=ok AND fs.ReadBlock(fl,y.ADR(li),y.SIZE(li));
  585.   IF li#iVer THEN ok:=FALSE;END;
  586.  ok:=ok AND fs.ReadBlock(fl,y.ADR(colar),y.SIZE(colar));
  587.  IF fs.Close(fl) THEN END;
  588.  IF ok THEN SetCols;END;
  589. END;
  590. IF ~ok THEN ReadCols;END;
  591. END LoadColsOn;
  592.  
  593. PROCEDURE UseCols;
  594. VAR li:LONGINT;
  595. BEGIN;
  596. ReadCols;
  597. IF fs.Open(fl,"ENV:wcc.prefs",TRUE) THEN
  598.  li:=pVers;IF fs.WriteBlock(fl,y.ADR(li),y.SIZE(li)) THEN END;
  599.  li:=iVer;IF fs.WriteBlock(fl,y.ADR(li),y.SIZE(li)) THEN END;
  600.  IF fs.WriteBlock(fl,y.ADR(colar),y.SIZE(colar)) THEN END;
  601.  IF fs.Close(fl) THEN END;
  602. END;
  603. END UseCols;
  604.  
  605. PROCEDURE SaveCols;
  606. VAR li:LONGINT;
  607. BEGIN;
  608. ReadCols;
  609. IF fs.Open(fl,"ENVARC:wcc.prefs",TRUE) THEN
  610.  li:=pVers;IF fs.WriteBlock(fl,y.ADR(li),y.SIZE(li)) THEN END;
  611.  li:=iVer;IF fs.WriteBlock(fl,y.ADR(li),y.SIZE(li)) THEN END;
  612.  IF fs.WriteBlock(fl,y.ADR(colar),y.SIZE(colar)) THEN END;
  613.  IF fs.Close(fl) THEN END;
  614. UseCols;
  615. END;
  616. END SaveCols;
  617.  
  618. PROCEDURE SaveColsAs;
  619. VAR li:LONGINT;
  620. BEGIN;
  621. IF frq.FileReqWin("Save WCC prefs file",pfnam,prjWnd) THEN
  622. ReadCols;
  623. IF fs.Open(fl,pfnam,TRUE) THEN
  624.  li:=pVers;IF fs.WriteBlock(fl,y.ADR(li),y.SIZE(li)) THEN END;
  625.  li:=iVer;IF fs.WriteBlock(fl,y.ADR(li),y.SIZE(li)) THEN END;
  626.  IF fs.WriteBlock(fl,y.ADR(colar),y.SIZE(colar)) THEN END;
  627.  IF fs.Close(fl) THEN END;
  628. UseCols;
  629. END;
  630. END;
  631. END SaveColsAs;
  632.  
  633. PROCEDURE Disable;
  634. BEGIN;
  635. IF cx.ActivateCxObj(MyBrk,0)#0 THEN END;
  636. ChCol:=FALSE;
  637. END Disable;
  638.  
  639. PROCEDURE Enable;
  640. BEGIN;
  641. IF cx.ActivateCxObj(MyBrk,1)#0 THEN END;
  642. ChCol:=TRUE;
  643. END Enable;
  644.  
  645. PROCEDURE Init():BOOLEAN;
  646. VAR ret:BOOLEAN;
  647. BEGIN;
  648. ret:=TRUE;
  649. IF ret THEN
  650. MsPrt:=e.CreateMsgPort();
  651. IF MsPrt=NIL THEN ret:=FALSE;END;
  652. IF ret THEN
  653. NwBrk.version:=cx.nbVersion;
  654. NwBrk.name:=y.ADR("WCC");
  655. NwBrk.title:=y.ADR("WCC 4.0 by HDS");
  656. NwBrk.descr:=y.ADR("Workbench Colour Changer");
  657. NwBrk.unique:=SET{0,1};
  658. NwBrk.flags:=SET{cx.showHide};
  659. NwBrk.pri:=SHORT(SHORT(CxPri));
  660. NwBrk.port:=MsPrt;
  661. NwBrk.reservedChannel:=0;
  662. MyBrk:=cx.CxBroker(NwBrk,Err);
  663. IF Err#0 THEN ret:=FALSE;END;
  664. IF ret THEN
  665. MyFil:=cx.CxFilter(y.ADR(CxKey));
  666. MySnd:=cx.CxSender(MsPrt,cx.cxmIEvent);
  667. MyTrs:=cx.CxTranslate(NIL);
  668. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  669. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  670. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  671. cx.AttachCxObj(MyBrk,MyFil);
  672. cx.AttachCxObj(MyFil,MySnd);
  673. cx.AttachCxObj(MyFil,MyTrs);
  674. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  675. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  676. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  677. IF cx.ActivateCxObj(MyBrk,1)#0 THEN ret:=FALSE;END;
  678. IF MyFil=NIL THEN ret:=FALSE;END;
  679. IF MySnd=NIL THEN ret:=FALSE;END;
  680. IF MyTrs=NIL THEN ret:=FALSE;END;
  681. IF cx.CxObjError(MyBrk)#LONGSET{} THEN ret:=FALSE;END;
  682. IF cx.CxObjError(MyFil)#LONGSET{} THEN ret:=FALSE;END;
  683. IF cx.CxObjError(MyTrs)#LONGSET{} THEN ret:=FALSE;END;
  684. END;END;END;
  685. RETURN (ret);
  686. END Init;
  687.  
  688. PROCEDURE ShutDown;
  689. BEGIN;
  690. IF MyBrk#NIL THEN cx.DeleteCxObjAll(MyBrk);
  691. REPEAT;UNTIL e.GetMsg(MsPrt)=NIL;END;
  692. IF MsPrt#NIL THEN
  693. e.DeleteMsgPort(MsPrt);END;
  694. END ShutDown;
  695.  
  696. PROCEDURE CheckCx;
  697. BEGIN;
  698. IF MsPrt#NIL THEN
  699. REPEAT;
  700. eMsg:=e.GetMsg(MsPrt);
  701. IF eMsg#NIL THEN
  702. Msg:=y.VAL(cx.CxMsgPtr,eMsg);
  703. MsTp:=cx.CxMsgType(Msg);
  704. MsId:=cx.CxMsgID(Msg);
  705. e.ReplyMsg(eMsg);
  706.  IF (MsTp=LONGSET{cx.cxmIEvent})AND(~guiOn) THEN
  707.   guiOn:=TRUE;;END;
  708.  IF MsTp=LONGSET{cx.cxmCommand} THEN
  709.   IF MsId=cx.cmdDisable THEN Disable;END;
  710.   IF (MsId=cx.cmdAppear)AND(~guiOn) THEN guiOn:=TRUE;END;
  711.   IF (MsId=cx.cmdDisappear)AND(guiOn) THEN guiOn:=FALSE;END;
  712.   IF MsId=cx.cmdEnable THEN Enable;END;
  713.   IF MsId=cx.cmdKill THEN Quit:=TRUE;guiOn:=FALSE;END;
  714.   IF MsId=cx.cmdUnique THEN Quit:=TRUE;END;
  715.  END;
  716. END;
  717. UNTIL eMsg=NIL;
  718. END;
  719. END CheckCx;
  720.  
  721. PROCEDURE ImportSys;
  722. VAR buff:ARRAY 217 OF INTEGER;
  723.     fl:fs.File;
  724.     n,k,c:INTEGER;
  725. BEGIN;
  726. IF frq.FileReqWin("Load WB prefs file",wbnam,prjWnd) THEN
  727.  IF fs.Open(fl,wbnam,FALSE) THEN
  728.   FOR n:=0 TO 216 DO
  729.    IF fs.Read(fl,buff[n]) THEN END;
  730.   END;
  731.   IF fs.Close(fl) THEN END;
  732.   n:=0;c:=0;
  733.   WHILE c<8 DO
  734.    k:=buff[n+89];INC(c);
  735.    IF k>=0 THEN
  736.    IF k>3 THEN k:=ScrCols-8+k;END;
  737.    colar[k,0]:=buff[n+90] ;
  738.    colar[k,1]:=buff[n+91] ;
  739.    colar[k,2]:=buff[n+92] ;
  740.    colar[k,0]:=colar[k,0]+colar[k,0]*65536;
  741.    colar[k,1]:=colar[k,1]+colar[k,1]*65536;
  742.    colar[k,2]:=colar[k,2]+colar[k,2]*65536;
  743.    n:=n+4;
  744.    END;
  745.   END;
  746.   SetCols;
  747.  END;
  748. END;
  749. END ImportSys;
  750.  
  751. PROCEDURE ExportSys;
  752. TYPE iar=ARRAY 2 OF INTEGER;
  753. VAR buff:ARRAY 217 OF INTEGER;
  754.     fl:fs.File;
  755.     n,k,c:INTEGER;
  756.     l:LONGINT;
  757.     ia:iar;
  758.     fnam:ARRAY 256 OF CHAR;
  759. BEGIN;
  760. IF frq.FileReqWinSave("Save WB prefs file",wbnam,prjWnd) THEN
  761.  IF fs.Open(fl,wbnam,FALSE) THEN
  762.   FOR n:=0 TO 216 DO
  763.    IF fs.Read(fl,buff[n]) THEN END;
  764.   END;
  765.   IF fs.Close(fl) THEN END;
  766.   n:=0;c:=0;
  767.   WHILE c<8 DO
  768.    k:=buff[n+89];INC(c);
  769.    IF k>=0 THEN
  770.    IF k>3 THEN k:=ScrCols-8+k;END;
  771.    ia:=y.VAL(iar,colar[k,0]);
  772.    buff[n+90]:=ia[0];
  773.    ia:=y.VAL(iar,colar[k,1]);
  774.    buff[n+91]:=ia[0];
  775.    ia:=y.VAL(iar,colar[k,2]);
  776.    buff[n+92]:=ia[0];
  777.    n:=n+4;
  778.    END;
  779.   END;
  780.   IF fs.Open(fl,"ENV:Sys/palette.prefs",TRUE) THEN
  781.    FOR n:=0 TO 216 DO
  782.     IF fs.Write(fl,buff[n]) THEN END;
  783.    END;
  784.    IF fs.Close(fl) THEN END;
  785.   END;
  786.  END;
  787. END;
  788. END ExportSys;
  789.  
  790. PROCEDURE ImportIFF;
  791. VAR fl:fs.File;
  792.     si1,si2,si3:SHORTINT;
  793.     li,num:LONGINT;
  794.     fnam:ARRAY 256 OF CHAR;
  795. BEGIN;
  796. IF frq.FileReqWin("Load IFF Palette file",iffnam,prjWnd) THEN
  797.  IF fs.Open(fl,iffnam,FALSE) THEN
  798.   WHILE (fl.status=fs.ok)AND(li#1129136464) DO
  799.    IF fs.Read(fl,li) THEN END;
  800.   END;
  801.   IF li=1129136464 THEN
  802.    IF fs.Read(fl,num) THEN END;
  803.    num:=num DIV 3;
  804.    IF num>ScrCols THEN num:=ScrCols;END;
  805.    FOR li:=0 TO num-1 DO
  806.     IF fs.Read(fl,si1) THEN END;
  807.     IF fs.Read(fl,si2) THEN END;
  808.     IF fs.Read(fl,si3) THEN END;
  809.     colar[li,0]:=si1+si1*256+si1*65536+si1*16777216;
  810.     colar[li,1]:=si2+si2*256+si3*65536+si3*16777216;
  811.     colar[li,2]:=si3+si3*256+si2*65536+si2*16777216;
  812.    END;
  813.    SetCols;
  814.   END;
  815.   IF fs.Close(fl) THEN END;
  816.  END;
  817. END;
  818. END ImportIFF;
  819.  
  820. PROCEDURE SetCycle;
  821. VAR li:LONGINT;
  822. BEGIN;
  823.  li:=Cycl;
  824.  IF rq.GetLong(li,"Set cycle delay (1/50 secs)",NIL,rq.Window,prjWnd,rq.glMax,1,rq.glMin,1000,rq.glWidth,ComputeX(250),u.done) THEN
  825.   Cycl:=li;
  826.  END;
  827. END SetCycle;
  828.  
  829. PROCEDURE ExportIFF;
  830. VAR fl:fs.File;
  831.     si1,si2,si3:SHORTINT;
  832.     li,num:LONGINT;
  833.     fnam:ARRAY 256 OF CHAR;
  834. BEGIN;
  835. rq.vEZRequestTags("Sorry, not\nimplemented yet.","Uhh.",NIL,NIL,rq.Window,prjWnd,u.done);
  836. END ExportIFF;
  837.  
  838. PROCEDURE GUI;
  839. BEGIN;
  840.  ReadColsCn;
  841.  IF SetupScreen()=0 THEN
  842.  IF OpenprjWindow()=0 THEN
  843.  n:=20;
  844.   REPEAT;
  845.    CheckCx;
  846.    ms:=gt.GetIMsg(prjWnd.userPort);
  847.    IF ms#NIL THEN
  848.     n:=-1;
  849.     iad:=ms.iAddress;
  850.     IF I.gadgetUp IN ms.class THEN
  851.      n:=iad.gadgetID;
  852.      IF n=GDEdit THEN
  853.       IF rq.PaletteRequest("Change Colors...",NIL,u.done)#0 THEN END;END;
  854.      IF n=GDLoad THEN LoadCols;END;
  855.     END;
  856.     IF I.menuPick IN ms.class THEN
  857.      IF ms.code=mnQuit THEN Quit:=TRUE;guiOn:=FALSE;END;
  858.      IF ms.code=mnOpen THEN LoadColsAs;END;
  859.      IF ms.code=mnSave THEN SaveColsAs;END;
  860.      IF ms.code=mnHide THEN guiOn:=FALSE;END;
  861.      IF ms.code=mnInWB THEN ImportSys;END;
  862.      IF ms.code=mnInIFF THEN ImportIFF;END;
  863.      IF ms.code=mnOutWB THEN ExportSys;END;
  864.      IF ms.code=mnOutIFF THEN ExportIFF;END;
  865.      IF ms.code=mnCycle THEN SetCycle;END;
  866.      IF ms.code=mnAbout THEN
  867.       rq.vEZRequestTags("Workbench Colour Changer\n""Version 4.01",
  868.       "Ok",NIL,NIL,rq.Window,prjWnd,
  869.       rq.ezReqTitle,y.ADR("WCC 4.01"),u.done);
  870.      END;
  871.     END;
  872.     e.ReplyMsg(ms);
  873.    ELSE
  874.     d.Delay(10);
  875.    END;
  876.   UNTIL (n=GDSave)OR(n=GDCancel)OR(n=GDUse)OR(~guiOn);
  877.   IF n=GDSave THEN SaveCols;END;
  878.   IF n=GDCancel THEN SetColsCn;END;
  879.   IF n=GDUse THEN UseCols;END;
  880. guiOn:=FALSE;
  881. CloseprjWindow;END;
  882. CloseDownScreen;END;
  883. END GUI;
  884.  
  885. PROCEDURE InitS;
  886. VAR m,l:INTEGER;
  887.     scr:I.ScreenPtr;
  888. BEGIN;
  889. scr:=I.LockPubScreen("Workbench");
  890. m:=scr.bitMap.depth;
  891. ScrCols:=1;
  892. FOR l:=1 TO m DO ScrCols:=ScrCols*2;END;
  893. I.UnlockPubScreen(NIL,scr);
  894. END InitS;
  895.  
  896. BEGIN;
  897. InitS;
  898. iVer:=I.int.libNode.version;
  899. wbnam:="ENV:Sys/palette.prefs";
  900. iffnam:=":";
  901. pfnam:="ENVARC:wcc.prefs";
  902. GetToolTypes;
  903. guiOn:=CxPop;
  904. cfc:=Cycl * 2;
  905. cnt:=Dela * 2;
  906. IF Init() THEN
  907.  ChCol:=TRUE;
  908.  Enable;
  909.  CheckCx;
  910.  Quit:=FALSE;
  911.  DoCh:=TRUE;
  912.  LoadColsFr;
  913.  REPEAT;
  914.   IF (cnt<1)AND(ChCol) THEN IF ok THEN SetCols;END;cnt:=cfc;END;
  915.   DEC(cnt);
  916.   d.Delay(25);
  917.   CheckCx;
  918.   IF guiOn THEN GUI;END;
  919.  UNTIL Quit;
  920. END;
  921. CLOSE
  922. ShutDown;
  923. END WCC4.
  924.  
  925.